home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / PASCAL / 0826.ZIP / FORM.ARC / _FORM.PAS < prev   
Pascal/Delphi Source File  |  1987-11-16  |  4KB  |  117 lines
  1. UNIT _Form;
  2. { Written to take the place of the FORM FUNCTION in Turbo 3.0 with BCD covers }
  3. { most of the 3.0 Function - November 1987 - Paul Mayer CIS [70040,645] }
  4.  
  5. INTERFACE
  6.  
  7. USES CRT;
  8.  
  9.  
  10. FUNCTION Form(Picture : STRING; Number : Real) : STRING;
  11.   { Pseudo form function }
  12.  
  13.   IMPLEMENTATION
  14.  
  15.   FUNCTION Form;
  16.     { Pseudo form function }
  17.  
  18.   VAR
  19.     Position, Dollar, Comma, Comma2, Start_Length, Picture_Length : Word;
  20.     Temp_Picture, Temp_Number : STRING[80];
  21.  
  22.     FUNCTION RealToString(Num : Real; Len, Places : Word) : STRING;
  23.       { Changes a real to a string }
  24.     VAR
  25.       S : STRING[80];
  26.     BEGIN
  27.       Str(Num:Len:Places, S);
  28.       RealToString := S;
  29.     END;                      { RealToString }
  30.  
  31.     FUNCTION Strip(S : STRING) : STRING;
  32.       { Strips our number of spaces so we know how big it is }
  33.     VAR
  34.       I : Word;
  35.       Store : STRING;
  36.     BEGIN
  37.       Store := '';
  38.       FOR I := 1 TO Length(S) DO
  39.         IF S[I] <> ' ' THEN Store := Store+S[I];
  40.       Strip := Store;
  41.     END;                      { Strip }
  42.  
  43.     FUNCTION Add_Dollar(S : STRING) : STRING;
  44.       { Puts dollar sign in figure }
  45.     VAR
  46.       I : Word;
  47.       Store : STRING;
  48.     BEGIN
  49.       Store := '';
  50.       FOR I := 1 TO Length(S) DO
  51.         IF S[I] = ' ' THEN Store := Store+S[I];
  52.       Store := Store+'$'+Copy(S, Length(Store)+1,
  53.       Length(S)-Length(Store));
  54.       Add_Dollar := Copy(Store, 2, Length(Store));
  55.     END;                      { Add_Dollar }
  56.  
  57.   BEGIN
  58.     Position := Pos('#', Picture);
  59.     Temp_Picture := Copy(Picture, 1, Position-1);
  60.     Dollar := Pos('$', Temp_Picture);
  61.     Delete(Picture, 1, Position-1);
  62.     Picture_Length := Length(Picture);
  63.     IF Dollar = Length(Temp_Picture) THEN
  64.       Delete(Temp_Picture, Dollar, 1);
  65.     Comma := Pos(',', Picture);
  66.     Comma2 := Pos(',', Copy(Picture, Comma+1, 5));
  67.     Position := Pos('.', Picture);
  68.     IF Dollar > 0 THEN
  69.       BEGIN
  70.         Picture_Length := Picture_Length+1;
  71.         Position := Position+1;
  72.       END;
  73.     Start_Length := Picture_Length;
  74.     IF Position > 0 THEN
  75.       Temp_Number := RealToString(Number, Picture_Length,
  76.       Picture_Length-Position)
  77.     ELSE
  78.       BEGIN
  79.         Temp_Number := RealToString(Number, Picture_Length, 0)
  80.       END;
  81.     IF Picture_Length < 11 THEN
  82.       BEGIN
  83.         IF ((Comma > 0) AND (Length(Strip(Temp_Number)) > 6)) THEN
  84.           Insert(',', Temp_Number, Pos('.', Temp_Number)-3);
  85.       END
  86.     ELSE IF Picture_Length > 10 THEN
  87.       BEGIN
  88.         IF ((Comma > 0) AND (Length(Strip(Temp_Number)) > 6)) THEN
  89.           Insert(',', Temp_Number, Pos('.', Temp_Number)-3);
  90.         IF ((Comma2 > 0) AND (Length(Strip(Temp_Number)) > 10)) THEN
  91.           Insert(',', Temp_Number, Pos('.', Temp_Number)-7);
  92.         IF ((Comma > 0) AND (Length(Strip(Temp_Number)) < 12)) THEN
  93.           Insert(' ', Temp_Number, 1);
  94.         IF ((Comma > 0) AND (Length(Strip(Temp_Number)) < 8)) THEN
  95.           Delete(Temp_Number, 1, 1);
  96.       END;
  97.     IF Dollar > 0 THEN Temp_Number := Add_Dollar(Temp_Number);
  98.     IF ((Comma > 0) AND (Copy(Temp_Number, 1, 1) = ' ')) THEN
  99.       Delete(Temp_Number, 1, 1);
  100.     IF ((Comma2 > 0) AND (Copy(Temp_Number, 1, 1) = ' ')) THEN
  101.       Delete(Temp_Number, 1, 1);
  102.     IF (Comma > 0) AND (Pos(',', Temp_Number) = 0) THEN
  103.       Insert(' ', Temp_Number, 1);
  104.     IF (Comma2 > 0) AND (Comma > 0) AND (Pos(',', Temp_Number) = 0) THEN
  105.       Insert(' ', Temp_Number, 1);
  106.     IF ((Dollar > 0) AND (Copy(Temp_Number, 1, 1) = ' ')) THEN
  107.       BEGIN
  108.         Start_Length := Start_Length+1;
  109.       END;
  110.     Form := Temp_Picture+Temp_Number;
  111.     IF Length(Temp_Number) > Start_Length THEN
  112.       FORM := Temp_Picture+Copy('********************************',
  113.       1, Start_Length);
  114.   END;                        { Pseudo form function }
  115.  
  116.   END.
  117.